perm filename CREDPY[GEM,BGB]1 blob
sn#021792 filedate 1973-03-25 generic text, type T, neo UTF8
00100 ;TITLE III
00200 ; -- DISPLAY SUBROUTINES -- NOVEMBER 1972.
00300
00400 ;DISPLAY UUO CODES.
00500 OPDEF DPYPOS [XWD 702100,0]
00600 OPDEF DPYSIZ [XWD 702140,0]
00700 OPDEF DPYCLR [XWD 701000,0]
00800 OPDEF UPG [XWD 703000,0]
00900 OPDEF GETLIN [TTYUUO 6,]
01000
01100 A←1↔B←2↔C←3
01200
01300 RV←←6
01400 AVCO←←106
01500 VIS←←0
01600 EP←←20
01700 INV←←40
01800 SVS←←100
01900 SV←←2
02000 DPYBUF: DPYBU.
02100 =2048↔1↔XWD 1,=2048
02200 DPYBU.: BLOCK 4000
02300
02400 ;SOURCE WINDOW.
02500 SX: 0
02600 SY: 0
02700 SOX: 0
02800 SOY: 0
02900
03000 ;OBJECT WINDOW.
03100 OX: 0
03200 OY: 0
03300 MAG: 3.4
03400 DEL: 32.0
03500
03600 ;PSEUDO BEAM POSITION.
03700 XXX: 0
03800 YYY: 0
03900
04000
04100 DECLARE{XL,XH,YL,YH}
04200 IGNORE: 0
04300 DPYPTR: 0
04400 BUFEND: 0
04500 BUFHD: 0
04600 0
00100 DPYBIG: LAC 1,ARG1
00200 LACI 3,INV+RV ;ZERO LENGTH RELATIVE-INVISIBLE VECTOR
00300 DPB 1,[POINT 3,3,27]
00400 PUSH P,(P) ;COPY PC.
00500 GO LV2
00600
00700 DPYBRT: LAC 1,ARG1
00800 LACI 3,INV+RV
00900 DPB 1,[POINT 3,3,24]
01000 PUSH P,(P) ;COPY PC.
01100 GO LV2
01200
01300 AIVECT: SKIPA C,[INV+AVCO]
01400 AVECT: LACI C,VIS+AVCO
01500 LV: LAC 1,ARG2↔LAC 2,ARG1
01600 SKIPGE IGNORE↔POP2J
01700 LVC: DPB A,[POINT 11,C,10]
01800 DPB B,[POINT 11,C,21]
01900 LV2: AOS A,DPYPTR
02000 DAC C,(A)
02100 LV3: LIPI A,<(<POINT 7,0,35>)>
02200 DAC A,DPYPTR
02300 LACI A,(A)
02400 CAML A,BUFEND
02500 SETOM IGNORE
02600 POP2J
02700
00100 DPYSTR: LAC 3,ARG1
00200 LIPI 3,440700
00300 ILDB 3↔JUMPE POP1J.
00400 CALL(DTYO,0)↔GO DPYSTR+2
00500
00600 DTYO: LAC 1,ARG1
00700 IDPB A,DPYPTR
00800 CDR A,DPYPTR
00900 CAML A,BUFEND
01000 SETOM IGNORE
01100 POP1J
01200
01300 DPYCLR: SKIPL DPYFLG#
01400 DPYCLR
01500 SETZM BUFHD
01600 POPJ P,
01700
01800 DPYOUT:
01900 SKIPN 1,BUFHD↔GO .+6
02000 LAC 2,DPYPTR↔DAC 2,-2(1)
02100 LACI 2,2(2)↔SUB 2,1↔DAC 2,-1(1)
02200 CDR B,DPYPTR
02300 SUB B,BUFHD
02400 ADDI B,1
02500 DAC B,BUFHD+1
02600 LAC 1,ARG1
02700 DPB A,[POINT 4,.+3,12]↔IOR A,DPYFLG↔SKIPL A↔UPG BUFHD
02800 POP1J
02900
03000 DPYSET: SETZM DPYFLG
03100 LAC 1,ARG1
03200 ADDI 1,2
03300 DAC 1,BUFHD
03400 CDR 2,-3(1) ;SIZE
03500 ADDI 2,-3(1)
03600 SUBI 2,1
03700 SETZM IGNORE
03800 DAC 2,BUFEND
03900 CLR2: LAC A,BUFHD
04000 LACI B,1
04100 DAC B,1(A)
04200 LACI B,2(A)
04300 LIPI B,1(A)
04400 BLT B,@BUFEND ;SET DPY BUFFER TO NULL CHARACTER WORDS
04500 PUSH P,(P) ;COPY PC.
04600 GO LV3
00100 ;CLIPER - 2D LINE SEGMENT CLIPPER - AUGUST 1972.
00200
00300
00400 SUBR(CROP)--------------------------------------------------------
00500 BEGIN CLIPIN
00600 LAC 1,OX↔LAC MAG↔FMP SX↔FSB 1,0↔DAC 1,SOX
00700 LAC 1,OY↔LAC MAG↔FMP SY↔FSB 1,0↔DAC 1,SOY
00800
00900 LAC 1,OX↔LAC MAG↔FMP[155.0]↔FSB 1,0
01000 CAMG 1,[-510.0]↔LAC 1,[-510.0]↔DAC 1,XL
01100 LAC 1,OX↔LAC MAG↔FMP[155.0]↔FAD 1,0
01200 CAML 1,[ 510.0]↔LAC 1,[510.0]↔DAC 1,XH
01300
01400 LAC 1,OY↔LAC MAG↔FMP[115.0]↔FSB 1,0
01500 CAMG 1,[-470.0]↔LAC 1,[-470.0]↔DAC 1,YL
01600 LAC 1,OY↔LAC MAG↔FMP[115.0]↔FAD 1,0
01700 CAML 1,[ 470.0]↔LAC 1,[470.0]↔DAC 1,YH
01800
01900 POP0J
02000 BEND;12/20/72-----------------------------------------------------
00100 SUBR(AI)----------------------------------------------------------
00200 BEGIN AI
00300 LAC ARG2↔FMP MAG↔FAD SOX↔DAC XXX
00400 LAC ARG1↔FMP MAG↔FAD SOY↔DAC YYY
00500 SETZM AIVFLG
00600 POP2J
00700 BEND;12/20/72-----------------------------------------------------
00800
00900 AIVFLG:0
01000 SUBR(AV)----------------------------------------------------------
01100 BEGIN AV
01200 LAC XXX↔DAC X1
01300 LAC YYY↔DAC Y1
01400 LAC ARG2↔FMP MAG↔FAD SOX↔DAC XXX↔DAC X2
01500 LAC ARG1↔FMP MAG↔FAD SOY↔DAC YYY↔DAC Y2
01600 CALL(CLIP,X1,Y1,X2,Y2)
01700 JUMPE 1,[SETZM AIVFLG↔POP2J]
01800 CAIN 1,1↔GO[
01900 SKIPN AIVFLG↔GO[
02000 SETOM AIVFLG↔GO L1+1]↔GO L2]
02100 L1: SETZM AIVFLG
02200 FIXX 6,↔FIXX 7,↔CALL(AIVECT,6,7)
02300 L2: FIXX 8,↔FIXX 9,↔CALL(AVECT,8,9)
02400 POP2J
02500 DECLARE{X1,Y1,X2,Y2}
02600 BEND;12/20/72-----------------------------------------------------
02700
02800 ;COLUMN INTO X-COORDINATE.
02900 SUBR(GETXY)VERTEX-------------------------------------------------
03000 BEGIN GETXY; GET DISPLAY COORDINATES FROM ROW-COL COORDINATES.
03100 ;RETURN VALUES IN STACK.
03200
03300 ;COLUMN INTO X-COORDINATE.
03400 LAC 1,ARG1↔PUSH P,(P) ;COPY PC.
03500 COL 0,1
03600 SKIPN FLGKINK↔GO .+3↔ADDI 40↔ANDCMI 77 ;NO DEKINK.
03700 SUBI =144*=64↔FSC 225↔DAC 0,ARG2 ;DPY X.
03800
03900 ;ROW INTO Y-COORDINATE.
04000 ROW 2,1
04100 SKIPN FLGKINK↔GO .+3↔ADDI 2,40↔ANDCMI 2,77 ;NO DEKINK.
04200 LACI =108*=64↔SUB 0,2↔FSC 225↔DAC 0,ARG1 ;DPY Y.
04300 POP0J
04400
04500 BEND;1/4/73-------------------------------------------------------
00100 DECLARE{AAA,BBB,CCC,FLGO,FLGZ,AXH,AXL,BYH,BYL,QNE,QNW,QSW,QSE}
00200 SUBR(CLIP)--------------------------------------------------------
00300 ; FLG ← CLIP(X1,Y1,X2,Y2) RETURN TRUE WHEN PORTION IS VISIBLE.
00400 BEGIN CLIP
00500 ACCUMULATORS{X1,Y1,X2,Y2,PDL}
00600 PTR←13
00700
00800 ;PICK 'EM UP;
00900 LAC X1,ARG4↔LAC Y1,ARG3
01000 LAC X2,ARG2↔LAC Y2,ARG1
01100 LACI PTR,PDL-1
01200
01300 ;SET NSEW BITS.
01400 SETZB 1
01500 CAMLE Y1,YH↔TRO 8↔CAMLE Y2,YH↔TRO 1,8; NORTH.
01600 CAMGE Y1,YL↔TRO 4↔CAMGE Y2,YL↔TRO 1,4; SOUTH.
01700 CAMLE X1,XH↔TRO 2↔CAMLE X2,XH↔TRO 1,2; EAST.
01800 CAMGE X1,XL↔TRO 1↔CAMGE X2,XL↔TRO 1,1; WEST.
01900
02000 ;EASY OUTSIDER EDGE.
02100 TRNE 0,(1)↔GO [OUTSIDE: SETZ 1,↔POP4J]
02200
02300 ;EASY INSIDER VERTICES.
02400 JUMPE 0,[PUSH PTR,X1↔PUSH PTR,Y1↔GO .+1]
02500 JUMPE 1,[PUSH PTR,X2↔PUSH PTR,Y2↔GO .+1]
02600 DEFINE DONE{CAMN PTR,[XWD 4,PDL+3]↔GO L}
02700 CAMN PTR,[XWD 4,PDL+3]↔GO[LACI 1,1↔GO L+1]
02800
02900 ;COMPUTE EDGE COEFFICIENTS.
03000 LAC Y1↔FSBR Y2↔DAC AAA
03100 LAC X2↔FSBR X1↔DAC BBB
03200 LAC X2↔FMPR Y1↔MOVNM CCC
03300 LAC X1↔FMPR Y2↔FADRM CCC
03400
03500 ;PARTIAL PRODUCTS.
03600 LAC AAA↔FMPR XH↔DAC AXH
03700 LAC AAA↔FMPR XL↔DAC AXL
03800 LAC BBB↔FMPR YH↔DAC BYH
03900 LAC BBB↔FMPR YL↔DAC BYL
04000
04100 ;CORNER Q'S.
04200 SETOM FLGO↔SETZM FLGZ
04300 LAC AXH↔FADR BYH↔FADR CCC↔DAC QNE↔ANDM FLGO↔IORM FLGZ
04400 LAC AXL↔FADR BYH↔FADR CCC↔DAC QNW↔ANDM FLGO↔IORM FLGZ
04500 LAC AXL↔FADR BYL↔FADR CCC↔DAC QSW↔ANDM FLGO↔IORM FLGZ
04600 LAC AXH↔FADR BYL↔FADR CCC↔DAC QSE↔ANDM FLGO↔IORM FLGZ
04700
04800 ;HARD OUTSIDER CASES.
04900 SKIPGE FLGO↔GO OUTSIDE
05000 SKIPL FLGZ↔GO OUTSIDE
00100 ;XY-CLIPPER continued.
00200 ;NORTH BORDER CROSSING.
00300 LAC QNE↔XOR QNW↔SKIPL↔GO L2
00400 LAC Y1↔CAMGE Y2↔LAC Y2↔CAMG YH↔GO L2
00500 LAC BYH↔FADR CCC↔MOVNS↔FDVR AAA↔PUSH PTR,
00600 LAC YH↔PUSH PTR,
00700 DONE
00800
00900 ;SOUTH BORDER CROSSING.
01000 L2: LAC QSE↔XOR QSW↔SKIPL↔GO L3
01100 LAC Y1↔CAMLE Y2↔LAC Y2↔CAML YL↔GO L3
01200 LAC BYL↔FADR CCC↔MOVNS↔FDVR AAA↔PUSH PTR,
01300 LAC YL↔PUSH PTR,
01400 DONE
01500
01600 ;EAST BORDER CROSSING.
01700 L3: LAC QSE↔XOR QNE↔SKIPL↔GO L4
01800 LAC X1↔CAMGE X2↔LAC X2↔CAMG XH↔GO L4
01900 LAC XH↔PUSH PTR,
02000 LAC AXH↔FADR CCC↔MOVNS↔FDVR BBB↔PUSH PTR,
02100 DONE
02200
02300 ;WEST BORDER CROSSING.
02400 L4: LAC QSW↔XOR QNW↔SKIPL↔GO L5
02500 LAC X1↔CAMLE X2↔LAC X2↔CAML XL↔GO L5
02600 LAC XL↔PUSH PTR,
02700 LAC AXL↔FADR CCC↔MOVNS↔FDVR BBB↔PUSH PTR,
02800 DONE
02900
03000 ;STRANGE EXIT - NSEW BIT MARKING & EDGE COEF ARE INCONSISTENT.
03100 L5: OUTSTR[ASCIZ/2D CLIPPER FALL THRU !
03200 /]↔ GO OUTSIDER
03300
03400 ;VISIBLE PORTION EXIT.
03500 L: SETO 1,
03600 POP4J
03700 LIT
03800 BEND;12/20/72-----------------------------------------------------
00100 SUBR(STADPY)------------------------------------------------------
00200 BEGIN STADPY; STATUS DISPLAY - BGB - 21 JAN 1973.
00300 CALL(DPYSET,DPYBUF)
00400 CALL(DPYBIG,[2])↔CALL(DPYBRT,[2])
00500 CALL(AIVECT,[=160],[=502])
00600 CALL(DPYSTR,[[ASCIZ/NODES/]])
00700 CALL(AIVECT,[=170],[=477])
00800 LAC 1,@BLKCNT↔CALL(DECDPY)
00900 CALL(AIVECT,[=240],[=502])
01000 CALL(DPYSTR,[[ASCIZ/LEVEL/]])
01100 CALL(AIVECT,[=250],[=477])
01200 SETZ 10,↔LAC 1,FILM
01300 SON 1,1↔JUMPE 1,.+5
01400 SON 1,1↔JUMPE 1,.+3
01500 CW 1,1↔NCNT 10,1↔CALL(OD)
01600 CALL(DPYOUT,[10])
01700 POP0J
01800 BEND;1/21/73------------------------------------------------------
01900
02000 SUBR(DPYIMG)------------------------------------------------------
02100 BEGIN DPYIMG; - DISPLAY 1ST IMAGE OF THE FILM - BGB - 4 DEC 1972.
02200 CALL(STADPY)
02300 CALL(DPYBLK)
02400 CALL(DPYGRID)
02500
02600 ;SQUARE FRAME.
02700 CALL(DPYSET,DPYBUF)
02800 CALL(AIVECT,[-=510],[-=470])
02900 CALL(AVECT,[ =510],[-=470])
03000 CALL(AVECT,[ =510],[ =470])
03100 CALL(AVECT,[-=510],[ =470])
03200 CALL(AVECT,[-=510],[-=470])
03300
03400 ;LOOP THE LEVELS, LOOP THE POLYGONS.
03500 LAC 1,FILM
03600 MARK 1,FILBIT↔SON 1,1↔JUMPE 1,L2 ;FIRST IMAGE.
03700 SKIPE FLGWED↔GO L3
03800
03900 ;CONTOUR DISPLAYS.
04000 SON 1,1↔DAC 1,LEV0#↔DAC 1,LEV1# ;FIRST LEVEL.
04100 L0: LAC 1,LEV1↔CDR 1,(1)↔DAC 1,LEV1 ;CDR-LEVEL-RING.
04200 SON 1,1↔JUMPE 1,L1A
04300 DAC 1,PGN0#↔DAC 1,PGN1# ;FIRST POLYGON.
04400 L1: LAC 1,PGN1↔CDR 1,(1)↔DAC 1,PGN1 ;CDR-POLY-RING.
04500 CALL(DPYGON,1)
04600 LAC 1,PGN1↔CAME 1,PGN0↔GO L1 ;POLY-RING-END.
04700 L1A: LAC 1,LEV1↔CAME 1,LEV0↔GO L0 ;LEVEL-RING-END.
04800 L2: CALL(DPYOUT,[0])
04900 POP0J ;EXIT.
05000
05100 ;WINGED EDGE DISPLAY.
05200 L3: PED 1,1↔DAC 1,E0#↔SETOM OLDRC ;FIRST EDGE.
05300 L4: CALL(DPYWED,1)
05400 PED 1,1
05500 CAME 1,E0↔GO L4
05600 GO L2
05700
05800 BEND;1/4/73-------------------------------------------------------
00100 SUBR(DPYGRID)-----------------------------------------------------
00200 BEGIN DPYGRID
00300 CALL(DPYSET,DPYBUF)
00400 LAC[50.0]↔CAML MAG↔GO L↔SKIPE FLGKINK↔GO L
00500 SETZ 10,↔FSB 10,MAG↔CAML 10,XL↔GO .-2↔FAD 10,MAG
00600 LAC 6,YL↔FIXX 6,↔LAC 7,YH↔FIXX 7,
00700 VLINES: LAC 5,10↔FIXX 5,
00800 CALL(AIVECT,5,6)↔CALL(AVECT,5,7)
00900 FAD 10,MAG↔CAMGE 10,XH↔GO VLINES
01000
01100 SETZ 10,↔FSB 10,MAG↔CAML 10,YL↔GO .-2↔FAD 10,MAG
01200 LAC 6,XL↔FIXX 6,↔LAC 7,XH↔FIXX 7,
01300 HLINES: LAC 5,10↔FIXX 5,
01400 CALL(AIVECT,6,5)↔CALL(AVECT,7,5)
01500 FAD 10,MAG↔CAMGE 10,YH↔GO HLINES
01600
01700 L: CALL(DPYOUT,[3])
01800 POP0J
01900
02000 BEND;12/14/72-----------------------------------------------------
02100
02200 SUBR(ID)----------------------------------------------------------
02300 BEGIN ID;IDENT DISPLAY - BGB - 13 DEC 1972.
02400 JUMPE 10,[
02500 CALL(DPYSTR,[[ASCIZ/NIL /]])↔AOS(P)↔POP0J]
02600 LACI 2,"U"
02700 FOR @' Eε{VEFPLI}{
02800 TESTZ 10,E'BIT↔LACI 2,"E"}
02900 TESTZ 10,FILBIT↔LACI 2,"F"
03000 CALL(DTYO,2)
03100 LACI 7,6↔DIPZ 10,10
03200 JFFO 10,.+1↔CAIL 11,3↔GO[
03300 ROT 10,3↔SUBI 11,3↔SOJA 7,.-1]↔ZAP 10
03400 L: ROT 10,3↔ADDI 10,60
03500 CALL(DTYO,10)↔ZAP 10↔SOJG 7,L
03600 CALL(DTYO,[" "])
03700 AOS(P)↔POP0J
03800 BEND;12/13/72-----------------------------------------------------
03900
04000 SUBR(OD)----------------------------------------------------------
04100 BEGIN OD;OCTAL HALF WORD DISPLAY - BGB - 13 DEC 1972.
04200 JUMPE 10,[CALL(DPYSTR,[[ASCIZ/--- /]])↔POP0J]
04300 LACI 7,6↔DIPZ 10,10↔SETO
04400 L: ROT 10,3↔ADDI 10,60↔TRNE 10,17↔SETZ
04450 JUMPN 0,.+3↔CALL(DTYO,10)↔ZAP 10↔SOJG 7,L
04500 CALL(DTYO,[" "])↔POP0J
04600 BEND;12/13/72-----------------------------------------------------
00100 SUBR(DECDPY)------------------------------------------------------
00200 BEGIN DECDPY;DECIMAL NUMBER DISPLAY - BGB - 17 DEC 1972.
00300 L: JUMPGE 1,.+5
00400 MOVM 2,1
00500 CALL(DTYO,["-"])
00600 LAC 1,2
00700 IDIVI 1,12
00800 PUSH P,2
00900 SKIPE 1
01000 PUSHJ P,L
01100 POP P,1↔ADDI 1,60
01200 CALL(DTYO,1)
01300 POP0J
01400 BEND;12/17/72-----------------------------------------------------
01500
01600 SUBR(BLKTYPE)BLK--------------------------------------------------
01700 BEGIN BLKTYPE; CONVERT BLOCK TYPE FROM UNARY TO BINARY.
01800 ;BGB - 31 DECEMBER 1972.
01900 LAC 1,ARG1
02000 TYPE 1,1
02100 ANDI 1,177
02200 CAIL 1,020↔GO L
02300 JUMPE 1,POP1J.
02400
02500 ;CAIN 1,000↔LACI 1,0 ;EMPTY.
02600 ;CAIN 1,001↔LACI 1,1 ;VERTEX.
02700 ;CAIN 1,002↔LACI 1,2 ;EDGE.
02800 CAIN 1,004↔LACI 1,3 ;FACE.
02900
03000 CAIN 1,010↔LACI 1,4 ;POLYGON.
03100 POP1J↔L:CAIN 1,020↔LACI 1,5 ;LEVEL.
03200 CAIN 1,040↔LACI 1,6 ;IMAGE.
03300 CAIN 1,100↔LACI 1,7 ;FILM.
03400 POP1J
03500 BEND;12/31/72-----------------------------------------------------
00100 SUBR(DPYBLK)------------------------------------------------------
00200 BEGIN DPYBLK; DISPLAY CONTENTS OF A BLOCK - BGB - 13 DEC 1972.
00220 YORG ←← -=280
00300 CALL(DPYSET,DPYBUF)
00400 SKIPN 15,QBLK↔GO L2
00500 SETQ(16,{BLKTYPE,QBLK})
00600
00700 ;DISPLAY BLOCK TYPE LABEL.
00800 CALL(AIVECT,[=320],[YORG-0])
00900 LAC[
01000 [ASCIZ/EMPTY/] ↔ [ASCIZ/VERTEX/]
01100 [ASCIZ/EDGE/] ↔ [ASCIZ/FACE/]
01200 [ASCIZ/POLYGON/] ↔ [ASCIZ/LEVEL/]
01300 [ASCIZ/IMAGE/] ↔ [ASCIZ/FILM/] ](16)
01400 L0: CALL(DPYSTR,0)
01500 L1: CALL(DTYO,["-"])↔LAC 10,15↔CALL(ID)↔JFCL
01600
00100 ;DISPLAY CONTENTS OF THE FIRST THREE WORDS OF THE NODE.
00200
00300 RELOC 14,15 ;GET RELLOCATION BITS.
00400 TRNE 14,$↔LACI 14,333333 ;EDGE CHEAT.
00500
00600 CALL(AIVECT,[=280],[YORG-=40])
00700 CALL(DPYSTR,{[[ASCIZ/,. 0 /]]})
00800 CAR 10,0(15)↔TRNE 14,200000↔CALL(ID)↔CALL(OD)
00900 CDR 10,0(15)↔TRNE 14,100000↔CALL(ID)↔CALL(OD)
01000
01100 CALL(AIVECT,[=280],[YORG-=60])
01200 CALL(DPYSTR,{[[ASCIZ/<> 1 /]]})
01300 CAR 10,1(15)↔TRNE 14,20000↔CALL(ID)↔CALL(OD)
01400 CDR 10,1(15)↔TRNE 14,10000↔CALL(ID)↔CALL(OD)
01500
01600 CALL(AIVECT,[=280],[YORG -=80])
01700 CALL(DPYSTR,{[[ASCIZ/ 2 /]]})
01800 CAR 10,2(15)↔CALL(OD)
01900 CDR 10,2(15)↔CALL(OD)
02000
02100 ;DISPLAY CONTENTS OF THE LAST THREE WORDS OF THE NODE.
02200
02300 CALL(AIVECT,[=280],[YORG -=120])
02400 CALL(DPYSTR,{[[ASCIZ/↓↑ 3 /]]})
02500 CAR 10,3(15)↔TRNE 14,2000↔CALL(ID)↔CALL(OD)
02600 CDR 10,3(15)↔TRNE 14,1000↔CALL(ID)↔CALL(OD)
02700
02800 CALL(AIVECT,[=280],[YORG -=140])
02900 CALL(DPYSTR,{[[ASCIZ/≤≥ 4 /]]})
03000 CAR 10,4(15)↔TRNE 14,200↔CALL(ID)↔CALL(OD)
03100 CDR 10,4(15)↔TRNE 14,100↔CALL(ID)↔CALL(OD)
03200
03300 CALL(AIVECT,[=280],[YORG -=160])
03400 CALL(DPYSTR,{[[ASCIZ/←→ 5 /]]})
03500 CAR 10,5(15)↔TRNE 14,20↔CALL(ID)↔CALL(OD)
03600 CDR 10,5(15)↔TRNE 14,10↔CALL(ID)↔CALL(OD)
03700
03800 CALL(AIVECT,[=280],[YORG -=180])
03900 CALL(DPYSTR,{[[ASCIZ/⊂⊃ 6 /]]})
04000 CAR 10,6(15)↔TRNE 14,2↔CALL(ID)↔CALL(OD)
04100 CDR 10,6(15)↔TRNE 14,1↔CALL(ID)↔CALL(OD)
00100 ;LIGHT UP THE QBLK WHEN IT IS A VERTEX OR A POLYGON.
00200 ; 0 = EMPTY. 4 = POLYGON.
00300 ; 1 = VERTEX. 5 = LEVEL.
00400 ; 2 = EDGE. 6 = IMAGE.
00500 ; 3 = FACE. 7 = FILM.
00600
00700 CAIN 16,2↔GO[
00800 CALL(DPYBRT,[5])
00900 SETOM OLDRC
01000 CALL(DPYWED,15)
01100 GO L2]
01200
01300 CAIN 16,4↔GO[CALL(DPYBRT,[5])↔CALL(DPYGON,15)↔GO L2]
01400 CAIN 16,3↔GO[CALL(DPYBRT,[5])↔CALL(DPYFACE,15)↔GO L2]
01500
01600 CAIN 16,1↔GO[
01700 CALL(DPYBRT,[5])
01800 CALL(GETXY,15)↔CALL(AI)
01900 CCW 1,15
02000 CALL(GETXY,1)↔CALL(AV)
02100 ↔GO L2]
02200
02300 L2: CALL(DPYBRT,[2])
02350 CALL(DPYOUT,[1])↔POP0J
02400 BEND;1/25/73------------------------------------------------------
02500 QBLK: 0
00100 ;DISPLAY HISTOGRAM.
00200 SUBR DPYHIS;------------------------------------------------------
00300 BEGIN DPYHIS;(PGON) - DISPLAY HISTOGRAM - BGB - 8 DEC 1972.
00400 X←←10 ↔ Y←←11 ↔ CNT←←14
00500
00600 CALL(HISTOG)
00700 CALL(DPYSET,DPYBUF)
00800 CALL(DPYBIG,[1])
00900
01000 ;SCALE THE IMAGE TO ITS LARGEST COLUMN.
01100 SETZ↔HRLZI 1,-77
01200 CAMGE 0,HISTO(1)↔LAC HISTO(1)↔AOBJN 1,.-2
01300 MOVE 1,[800.0]↔FSC 233↔FDV 1,0↔DAC 1,SY#
01400
01500 ;INITIALIZE HISTO LOOP.
01600 SETZ CNT,
01700 NIM X,=511↔NIM Y,-=404
01800 CALL(AIVECT,X,Y)↔MOVNS X
01900 CALL(AVECT,X,Y)
02000
02100 L1: SKIPN FTVSIX↔GO[TRNE CNT,3↔GO L2↔GO .+1]
02200 LAC Y,HISTO(CNT)↔FSC Y,233↔FMP Y,SY↔FIXX Y,
02300 SUBI Y,=400
02400 L2: CALL(AVECT,X,Y)
02500 TRNE CNT,3↔GO L3
02600 ;INTENSITY LEVEL NUMERAL.
02700 NIM 0,-=440↔SUBI X,10↔CALL(AIVECT,X,0)
02800 LAC CNT↔LSHC -3↔SKIPE↔IORI "0"↔IORI " "
02900 LSH 4↔LSHC 3
03000 IORI "0"↔ROT 0,-16↔IORI 1
03100 AOS 1,DPYPTR↔DAC(1)
03200 ;PEC CENT AT THIS LEVEL NUMERAL.
03300 NIM 0,-=465↔CALL(AIVECT,X,0)↔ADDI X,10
03400 LAC HISTO+0(CNT)↔ADD HISTO+1(CNT)
03500 ADD HISTO+2(CNT)↔ADD HISTO+3(CNT)
03600 IMULI =1000↔IDIVI =62208↔ADDI 5↔IDIVI =10
03700 JUMPE L4↔IDIVI =10
03800 ROT 1,-4
03900 SKIPE↔IORI "0"↔IORI " "
04000 LSH 3↔LSHC 4↔IORI "0"↔LSH 16↔IORI " %"
04100 LSH 8↔IORI 1↔AOS 1,DPYPTR↔DAC(1)
04200 L4: CALL(AIVECT,X,Y)
04300 ;ADVANCE.
04400 L3: ADDI X,20
04500 CALL(AVECT,X,Y)
04600 AOS CNT↔CAIE CNT,100↔GO L1
04700
04800 NIM -=400↔CALL(AVECT,X,0)
04900 CALL(DPYOUT,[0])↔CRLF↔POP0J
05000 BEND;12/16/72-----------------------------------------------------
00100 SUBR(DPYGON)PGON--------------------------------------------------
00200 BEGIN DPYGON; DISPLAY POLYGON - BGB - 4 DEC 1972.
00300
00400 ;FIRST EDGE/VERTEX ABSOLUTE INVISIBLE VECTOR.
00500 LAC 1,ARG1
00600 ARC 2,1↔SKIPG FLGRAR↔SON 2,1
00700 LAC 1,2
00800 JUMPE 1,POP1J.
00900 L0: DAC 1,E0#↔DAC 1,V#
01000 CALL(GETXY,1)↔PUSHJ P,AI
01100
01200 ;FOLLOW AROUND THE POLYGON WITH ABS VISIBLE VECTORS.
01300 L1: LAC 1,V↔CDR 1,0(1)↔DAC 1,V
01400 CALL(GETXY,1)↔LAC 1,V↔CNTRST 0,1↔MOVMS
01450 CAMG 0,VCUT↔GO[PUSHJ P,AI↔GO .+2]↔PUSHJ P,AV
01500 LAC 1,V↔EXO 2,1↔JUMPN 2,[
01600 ENDO 0,2↔CAME 0,V↔GO .+1
01700 CALL(GETXY,2)↔CALL(AV)
01800 CALL(GETXY,V)↔CALL(AV)↔GO .+1]
01900 LAC 1,V↔CAME 1,E0↔GO L1
02000
02100 ;IS DISPLAY BOTH ENABLED.
02200 SKIPL FLGRAR↔POP1J
02300 LAC 1,ARG1↔ARC 1,1↔CAME 1,E0↔JUMPN 1,L0↔POP1J
02400
02500 BEND;1/25/73------------------------------------------------------
00100 SUBR(DPYWED)EDGE--------------------------------------------------
00200 BEGIN DPYWED; DISPLAY WINGED EDGE - BGB - 4 JAN 1973.
00300 LAC 1,ARG1
00400 PVT 2,1↔LAC RC(2)
00500 CAMN OLDRC↔GO L1
00600 DAC OLDRC
00700 CALL(GETXY,2)↔CALL(AI)
00800 L1: LAC 1,ARG1
00900 NVT 2,1↔LAC RC(2)↔DAC OLDRC
01000 CALL(GETXY,2)↔CALL(AV)
01100 LAC 1,ARG1↔POP1J
01200 BEND;1/4/73-------------------------------------------------------
01300 OLDRC: -1
01400
01500 SUBR(DPYFACE)FACE-------------------------------------------------
01600 BEGIN DPYFACE; DISPLAY FACE - BGB - 4 JAN 1973.
01700 EXTERN ECCW
01800 LAC 1,ARG1↔DAC 1,FACE#
01900 PED 1,1↔DAC 1,E0#↔SETOM OLDRC
02000 L1: CALL(DPYWED,1)
02100 CALL(ECCW,1,FACE)
02200 CAME 1,E0↔GO L1
02300 POP1J↔LIT↔VAR
02400 BEND;1/4/73-------------------------------------------------------
02500
02600 END SA